home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 501-525 / disk_503 / pcq / pcq12a.lzh / Examples / Map.p < prev    next >
Text File  |  1990-10-04  |  14KB  |  590 lines
  1. Program Mapper;
  2.  
  3. {
  4.     This program maintains a map for the game Empire (by Chris Gray and
  5.     David Wright).  It doesn't do anything fancy like read sector dumps -
  6.     it's meant to replace graph paper with something a little more colorful
  7.     and easy to erase.
  8.  
  9.     I used the console.device and ANSI codes to do the drawing, simply
  10.     because I didn't feel like measuring fonts and all that.  Thus this
  11.     version is limited to 8 colors, whereas its MS-DOS cousin, ironically,
  12.     provides 16.
  13.  
  14.     The storage of the map itself is a dump of MS-DOS screen memory.  In
  15.     other words, each word corresponds to something like BBTTCCCC in
  16.     hex, where BB is the background color, TT is the foreground (or text)
  17.     color, and CCCC is the actual ASCII character.
  18.  
  19.     It would not be at all difficult to add a routine to parse the output
  20.     from the dump command.  If you did that, you could expand the inform-
  21.     ation window to list things like population and whatever.
  22.  
  23.     If you've never played Empire, it's your basic game of territorial
  24.     conquest, played over several weeks or months.  Players in our game
  25.     sign in over the modem, and play 30 minute turns every day (that's
  26.     30 minutes on line, plus 23.5 hours planning time).  It's a modern
  27.     version of an old mainframe game, and was brought to the Amiga
  28.     through the hard work of Chris Gray (the writer of the Draco compiler)
  29.     and several others.  If you like Risk, Reach for the Stars, etc. give
  30.     it a shot.  You'll end up writing programs like this.
  31.  
  32.     To use this program, just move around the map using the cursor keys.
  33.     If you type a printable character the program will insert the
  34.     character into the map at the current location in the current color.
  35.     Use F1,F2 and Shift-F1, Shift-F2 to cycle through the available
  36.     colors.  Press F10 to change to the color of the current sector.
  37.     Press Shift F10 to print the entire map to "prt:"
  38.  
  39.     This was originally written for a 32 X 32 map, and there may be
  40.     some lingering problems for other sizes.
  41. }
  42.  
  43.  
  44. {$I "Include:Intuition/Intuition.i"}
  45. {$I "Include:Graphics/Graphics.i"}
  46. {$I "Include:Graphics/View.i"}
  47. {$I "Include:Exec/Libraries.i"}
  48. {$I "Include:Utils/ConsoleUtils.i"}
  49. {$I "Include:Utils/DeadKeyConvert.i"}
  50. {$I "Include:Utils/CRT.i"}
  51. {$I "Include:Utils/StringLib.i"}
  52.  
  53. var
  54.     w          : WindowPtr;
  55.     infowindow : WindowPtr;
  56.     c          : Address; { CRT handle for w }
  57.     infocon    : Address; { Another CRT handle }
  58.     s          : ScreenPtr;
  59.  
  60.     MapName       : String;
  61.  
  62. Const
  63.     CenterX = 23;
  64.     CenterY = 8;
  65.  
  66.     CurrentText : Short = 1;
  67.     CurrentBack : Short = 0;
  68.  
  69.     CX          : Short = 0;
  70.     CY          : Short = 1;
  71.  
  72.     MapSize    = 32;
  73.     MinCoord   = -(MapSize div 2);
  74.     MaxCoord   = MapSize div 2 - 1;
  75.  
  76. Const
  77.     StdInName  : String = Nil;  { This program will not automatically }
  78.     StdOutName : String = Nil;  { open a console window, so no read/write }
  79.  
  80. Function OpenTheScreen : Boolean;
  81. var
  82.     ns : NewScreenPtr;
  83. begin
  84.     new(ns);
  85.     with ns^ do begin
  86.     LeftEdge := 0;
  87.     TopEdge  := 0;
  88.     Width    := 640;
  89.     Height   := 200;
  90.     Depth    := 3;
  91.     DetailPen := 7;
  92.     BlockPen  := 7;
  93.     ViewModes := 32768;
  94.     SType     := CUSTOMSCREEN_f;
  95.     Font      := Nil;
  96.     DefaultTitle := "Empire Map";
  97.     Gadgets   := nil;
  98.     CustomBitMap := nil;
  99.     end;
  100.     s := OpenScreen(ns);
  101.     dispose(ns);
  102.     OpenTheScreen := s <> nil;
  103. end;
  104.  
  105. Function OpenTheWindow : Boolean;
  106. {
  107.     Actually opens both the main map window and the information
  108.     window below it.  This could probably be arranged better, and
  109.     even fit on a low-res screen if your memory is tight.
  110. }
  111. var
  112.     nw : NewWindow;
  113. begin
  114.     with nw do begin
  115.     LeftEdge := 120;
  116.     TopEdge := 151;
  117.     Width := 380;
  118.     Height := 40;
  119.  
  120.     DetailPen := 7;
  121.     BlockPen  := 7;
  122.     IDCMPFlags := 0;
  123.     Flags := SIMPLE_REFRESH + ACTIVATE;
  124.     FirstGadget := Nil;
  125.     CheckMark := Nil;
  126.     Title := "";
  127.     Screen := s;
  128.     BitMap := Nil;
  129.     MinWidth := 0;
  130.     MaxWidth := -1;
  131.     MinHeight := 0;
  132.     MaxHeight := -1;
  133.     WType := CUSTOMSCREEN_f;
  134.     end;
  135.  
  136.     infowindow := OpenWindow(Adr(nw));
  137.     if infowindow = Nil then
  138.     OpenTheWindow := False;
  139.  
  140.     with nw do begin
  141.     TopEdge := 12;
  142.     Height  := 138;
  143.     end;
  144.  
  145.     w := OpenWindow(Adr(nw));
  146.     OpenTheWindow := w <> Nil;
  147. end;
  148.  
  149. Procedure ResetColors;
  150. {
  151.     Sets the eight colors of this screen to the normal ANSI values.
  152.     This way it looks about the same on the Amiga as the PC.  What
  153.     a shame.
  154. }
  155. var
  156.     vp : ViewPortPtr;
  157. begin
  158.     vp := ViewPortAddress(w);
  159.     SetRGB4(vp, 0, 0, 0, 0);    { Black    }
  160.     SetRGB4(vp, 1, 0, 0, 15);    { Blue    }
  161.     SetRGB4(vp, 2, 0, 15, 0);    { Green    }
  162.     SetRGB4(vp, 3, 0, 15, 15);    { Cyan    }
  163.     SetRGB4(vp, 4, 15, 0, 0);    { Red    }
  164.     SetRGB4(vp, 5, 15, 0, 15);    { Magenta }
  165.     SetRGB4(vp, 6, 10, 7, 0);    { Brown    }
  166.     SetRGB4(vp, 7, 15, 15, 15);    { Light Gray }
  167. end;
  168.  
  169. Procedure OpenEverything;
  170. {
  171.     Open, in this order, the console device, the graphics library (just
  172.     for the SetRGB4 calls), the screen, and both windows.  Then attach
  173.     a CRT unit to each window.
  174. }
  175. var
  176.     Error : Short;
  177. begin
  178.     OpenConsoleDevice;
  179.     GfxBase := OpenLibrary("graphics.library",0);
  180.     if OpenTheScreen then
  181.     if OpenTheWindow then begin
  182.         c := AttachConsole(w);
  183.         if c <> Nil then begin
  184.         infocon := AttachConsole(infowindow);
  185.         if infocon <> Nil then
  186.             Return;
  187.         DetachConsole(c);
  188.         end;
  189.     end;
  190.     CloseWindow(w);
  191.     CloseScreen(s);
  192.     CloseConsoleDevice;
  193. end;
  194.  
  195. Procedure CloseEverything;
  196. {
  197.     The same as OpenEverything, but reversed.
  198. }
  199. begin
  200.     DetachConsole(infocon);
  201.     DetachConsole(c);
  202.     CloseWindow(infowindow);
  203.     CloseWindow(w);
  204.     CloseScreen(s);
  205.     CloseLibrary(GfxBase);
  206.     CloseConsoleDevice;
  207. end;
  208.  
  209. Function Fix(s : Short) : Short;
  210. {
  211.     Adjust coordinate values for the toroidal shape of the map (on
  212.     a 32 sector wide map, -16 is the same as 16).
  213. }
  214. begin
  215.     while s < MinCoord do
  216.     s := s + MapSize;
  217.     while s > MaxCoord do
  218.     s := s - MapSize;
  219.     Fix := s;
  220. end;
  221.  
  222. {
  223.    Actual definitions for the map type and the map itself.  This
  224.    program, like Empire itself, only accepts square maps.
  225. }
  226.  
  227. Type
  228.     Column  = Array [MinCoord..MaxCoord] of Short;
  229.     MapType = Array [MinCoord..MaxCoord] of Column;
  230.  
  231. var
  232.     Command : Char;
  233.     Map     : MapType;
  234.  
  235. {
  236.     Draw the sector using a three-character string and the appropriate
  237.     color settings.  If you wanted to go to a smaller window size you
  238.     could cut this down to two or one character with little problem.
  239. }
  240.  
  241. Procedure DrawSector(Sector : Short);
  242. var
  243.     Buffer : Array [0..3] of Char;
  244. begin
  245.     TextColor(c, (Sector shr 8) and 7);
  246.     TextBackground(c, Sector shr 12);
  247.     Buffer := '   \0';
  248.     Buffer[1] := Chr(Sector);
  249.     WriteString(c, Adr(Buffer));
  250. end;
  251.  
  252. {
  253.     Draw the part of the map that will fit in the window, centered
  254.     on xx and yy.
  255. }
  256.  
  257. Procedure DrawMap(xx, yy : Short);
  258. var
  259.     x,y : Short;
  260.     row : Short;
  261. begin
  262.     CursOff(c);
  263.     row := 1;
  264.     for y := yy - 7 to yy + 7 do begin
  265.     GotoXY(c, 1, row);
  266.     for x := xx - 7 to xx + 7 do
  267.         DrawSector(Map[fix(y),fix(x)]);
  268.     Inc(row);
  269.     end;
  270.     CX := xx;
  271.     CY := yy;
  272.     CursOn(c);
  273. end;
  274.  
  275. {
  276.     Scroll the map left.  In order to avoid wrap-around problems,
  277.     this routine deletes the last three spaces on each line, then
  278.     inserts three spaces on the left side.
  279. }
  280.  
  281. Procedure ScrollLeft;
  282. var
  283.     i : Short;
  284.     x,y : Short;
  285. begin
  286.     for i := 1 to 15 do begin
  287.     GotoXY(c, 43, i);
  288.     ClrEOL(c);
  289.     GotoXY(c, 1, i);
  290.     WriteString(c, "\c3@");   { Insert 3 spaces }
  291.     end;
  292.     CX := Fix(Pred(CX));
  293.     x := Fix(CX - 7);
  294.     i := 1;
  295.     for y := CY - 7 to CY + 7 do begin
  296.     GotoXY(c, 1, i);
  297.     DrawSector(Map[Fix(y),x]);
  298.     Inc(i);
  299.     end;
  300. end;
  301.  
  302. {
  303.     Scroll the map to the right.  This routine deletes the first three
  304.     characters of each line, then draws the sectors at the right edge
  305.     of each line.
  306. }
  307.  
  308. Procedure ScrollRight;
  309. var
  310.     i : Short;
  311.     x : Short;
  312.     y : Short;
  313. begin
  314.     for i := 1 to 15 do begin
  315.     GotoXY(c, 1, i);
  316.     WriteString(c, "\c3P");
  317.     end;
  318.     CX := Fix(Succ(CX));
  319.     x := Fix(CX + 7);
  320.     i := 1;
  321.     for y := CY - 7 to CY + 7 do begin
  322.     GotoXY(c, 43, i);
  323.     DrawSector(Map[Fix(y),x]);
  324.     Inc(i);
  325.     end;
  326. end;
  327.  
  328. {
  329.     Scroll the window up.  This routine inserts a new first line,
  330.     then draws the sectors across.  Note that this is somewhat
  331.     faster than the left and right routines.
  332. }
  333.  
  334. Procedure ScrollUp;
  335. var
  336.     i : Short;
  337.     y : Short;
  338. begin
  339.     GotoXY(c, 1, 1);
  340.     WriteString(c, "\cL");
  341.     CY := Fix(Pred(CY));
  342.     y := Fix(CY - 7);
  343.     for i := CX - 7 to CX + 7 do
  344.     DrawSector(Map[y, Fix(i)]);
  345. end;
  346.  
  347. {
  348.     Scroll the window down.  Delete the first line, go to the last one,
  349.     and draw the sectors across.
  350. }
  351.  
  352. Procedure ScrollDown;
  353. var
  354.     i : Short;
  355.     y : Short;
  356. begin
  357.     GotoXY(c, 1, 1);
  358.     WriteString(c, "\cM");
  359.     CY := Fix(Succ(CY));
  360.     GotoXY(c, 1, 15);
  361.     y := Fix(CY + 7);
  362.     for i := CX - 7 to CX + 7 do
  363.     DrawSector(Map[y, Fix(i)]);
  364. end;
  365.  
  366. {
  367.     Load a map from the disk.  If there is a problem, the program
  368.     will abort ( the O- option was not used).
  369. }
  370.  
  371. Procedure LoadMap;
  372. var
  373.     x,y     : Short;
  374.     MapFile : File of MapType;
  375. begin
  376.     if reopen(MapName, MapFile) then begin
  377.     Read(MapFile, Map);
  378.     Close(MapFile);
  379.     Return;
  380.     end;
  381.     for x := MinCoord to MaxCoord do
  382.     for y := MinCoord to MaxCoord do
  383.         Map[y,x] := $0120;  { by default, each sector is space }
  384. end;
  385.  
  386. {
  387.     Save the current map, returning TRUE if everything goes OK
  388. }
  389.  
  390. Function SaveMap : Boolean;
  391. var
  392.     MapFile : File of MapType;
  393.     OK    : Boolean;
  394. begin
  395.     if open(MapName, MapFile) then begin
  396.     Write(MapFile, Map);
  397.     {$O-}
  398.     OK := IOResult = 0;
  399.     {$O+}
  400.     Close(MapFile);
  401.     SaveMap := OK;
  402.     end else
  403.     SaveMap := False;
  404. end;
  405.  
  406. {
  407.     Print the map on the preferences printer.  The printout will always
  408.     be centered on the capital (location 0,0), but that can easily be
  409.     changed.
  410. }
  411.  
  412. Procedure PrintMap;
  413. var
  414.     PrintFile : Text;
  415.     x, y : Integer;
  416.  
  417.     Procedure NumberRow;
  418.     begin
  419.     Write(PrintFile, '  ');
  420.     for x := MinCoord to MaxCoord do begin
  421.         case x of
  422.           -99..-10 : Write(PrintFile, ' 1');
  423.            -9.. -1 : Write(PrintFile, ' -');
  424.             0..  9 : Write(PrintFile, ' 0');
  425.            10.. 99 : Write(PrintFile, ' 1');
  426.         end;
  427.     end;
  428.     Writeln(PrintFile);
  429.     Write(PrintFile, '  ');
  430.     for x := MinCoord to MaxCoord do
  431.         Write(PrintFile, Abs(x) mod 10:2);
  432.     Writeln(PrintFile);
  433.     end;
  434.  
  435.     Procedure NumberColumn(i : Integer);
  436.     begin
  437.     case i of
  438.       -99..-10 : Write(PrintFile, Abs(i));
  439.        -9.. -1 : Write(PrintFile, i);
  440.         0..  9 : Write(PrintFile, '0', i);
  441.        10.. 99 : Write(PrintFile, i);
  442.     end;
  443.     end;
  444.  
  445. begin
  446.     if not open("prt:", PrintFile) then
  447.     return;
  448.     NumberRow;
  449.     Writeln(PrintFile);
  450.     for y := MinCoord to MaxCoord do begin
  451.     NumberColumn(y);
  452.     for x := MinCoord to MaxCoord do
  453.         Write(PrintFile, ' ', Chr(Map[y,x]));
  454.     Write(PrintFile, ' ');
  455.     NumberColumn(y);
  456.     Writeln(PrintFile);
  457.     end;
  458.     Writeln(PrintFile);
  459.     NumberRow;
  460.     Close(PrintFile);
  461. end;
  462.  
  463. {
  464.     Handle the function keys.  This is really primitive stuff,
  465.     but since I wanted it to match the PC version this was
  466.     the easiest way to handle it.
  467. }
  468.  
  469. Procedure ProcessFunctionKey(fnum : Short);
  470. begin
  471.     case fnum of
  472.       0 : begin  { F1 : cycle forward through text colors }
  473.           CurrentText := Succ(CurrentText) and 7;
  474.           TextColor(c, CurrentText);
  475.       end;
  476.       1 : begin  { F2 : cycle forward through background colors }
  477.           CurrentBack := Succ(CurrentBack) and 7;
  478.           TextBackground(c, CurrentBack);
  479.       end;
  480.       9 : begin  { F10 : Use the color of the current sector }
  481.           CurrentText := (Map[CY,CX] and $0F00) shr 8;
  482.           CurrentBack := (Map[CY,CX] and $F000) shr 12;
  483.           TextColor(c, CurrentText);
  484.           TextBackground(c, CurrentBack);
  485.       end;
  486.       10: begin  { Shift F1 : cycle backward through the text colors }
  487.           CurrentText := Pred(CurrentText) and 7;
  488.           TextColor(c, CurrentText);
  489.       end;
  490.       11: begin  { Shift F2 : cycle backward through the background colors }
  491.           CurrentBack := Pred(CurrentBack) and 7;
  492.           TextColor(c, CurrentBack);
  493.       end;
  494.       19 : PrintMap;  { Shift F10 : Print the map }
  495.     end;
  496. end;
  497.  
  498. {
  499.     Process anything that starts with a CSI, which in this case
  500.     means function keys and cursor keys.  Anything else is
  501.     ignored.
  502. }
  503.  
  504. Procedure ProcessCommand;
  505. var
  506.     Param : Short;
  507. begin
  508.     Param := 0;
  509.     Command := ReadKey(c);
  510.     while (Command >= '0') and (Command <= '9') do begin
  511.     Param := Param * 10 + (Ord(Command) - Ord('0'));
  512.     Command := ReadKey(c);
  513.     end;
  514.     TextBackground(c, 0);
  515.     case Command of
  516.       'A' : ScrollUp;
  517.       'B' : ScrollDown;
  518.       'C' : ScrollRight;
  519.       'D' : ScrollLeft;
  520.       '~' : ProcessFunctionKey(Param);
  521.     end;
  522. end;
  523.  
  524. {
  525.     Set the current sector to the command character, and draw it.
  526. }
  527.  
  528. Procedure SetMap;
  529. var
  530.     Buffer : Array [0..3] of Char;
  531. begin
  532.     GotoXY(c, Pred(CenterX),CenterY);
  533.     Map[CY,CX] := (CurrentBack shl 12) + (CurrentText shl 8) + Ord(Command);
  534.     DrawSector(Map[CY,CX]);
  535. end;
  536.  
  537. {
  538.     Write the current location and color to the information window
  539. }
  540.  
  541. Procedure WriteInfo;
  542. var
  543.     NBuf : Array [0..11] of Char;
  544.     Dummy : Integer;
  545. begin
  546.     TextColor(infocon, 7);
  547.     TextBackground(infocon, 0);
  548.     Dummy := IntToStr(Adr(NBuf), CY);
  549.     GotoXY(infocon, 1, 2);
  550.     ClrEOL(infocon);
  551.     GotoXY(infocon, 4, 2);
  552.     WriteString(infocon, "Row: ");
  553.     WriteString(infocon, Adr(NBuf));
  554.     Dummy := IntToStr(Adr(NBuf), CX);
  555.     GotoXY(infocon, 14, 2);
  556.     WriteString(infocon, "Column: ");
  557.     WriteString(infocon, Adr(NBuf));
  558.     TextColor(infocon, CurrentText);
  559.     TextBackground(infocon, CurrentBack);
  560.     GotoXY(infocon, 27, 2);
  561.     WriteString(infocon, "Color");
  562. end;
  563.  
  564. begin
  565.     MapName := "Empire.MAP";
  566.     OpenEverything;
  567.     ResetColors;
  568.     TextColor(c, CurrentText);
  569.     TextBackground(c, CurrentBack);
  570.     CursOff(infocon);
  571.     LoadMap;
  572.     DrawMap(0,0);
  573.     repeat
  574.     WriteInfo;
  575.     GotoXY(c, CenterX, CenterY);
  576.     CursOn(c);
  577.     Command := ReadKey(c);
  578.     CursOff(c);
  579.     if Command = '\c' then { CSI }
  580.         ProcessCommand
  581.     else if Command = '\e' then begin  { ESC }
  582.         if SaveMap then begin
  583.         CloseEverything;
  584.         Exit(0);
  585.         end;
  586.     end else if (Command >= ' ') and (Command <= '~') then
  587.         SetMap;
  588.     until False;
  589. end.
  590.